home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte0787.arc / IWPAS.ARC / DUMPER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-04-28  |  5.1 KB  |  210 lines
  1. {$P512}
  2. PROGRAM Dumper(input,output,picfile);
  3.  
  4. { Copyright (c) 1987, Ciarcia's Circuit Cellar          }
  5. {    All Rights Reserved                                }
  6.  
  7. {$U- control-break checking during execution            }
  8. {$C+ control-break checking during I/O operations       }
  9. {$R+ array range checking                               }
  10.  
  11. {$Ideclares.p                   declarations            }
  12. {$Ihexutil.p                    hex utilities           }
  13. {$Iserial.p                     serial interface code   }
  14. {$Ipictures.p                   picture file code       }
  15. {$Iimages.p                     image processing        }
  16.  
  17. CONST
  18.  
  19.  FF        = $0C;               { ordinary form feed... }
  20.  
  21.  
  22. {-------------------------------------------------------}
  23. { Dump hex values in picture                            }
  24.  
  25. PROCEDURE HexDump(pic : picptr);
  26.  
  27. VAR
  28.  picbyte   : BYTE;
  29.  bptr      : ^BYTE;
  30.  linectr   : INTEGER;
  31.  
  32. BEGIN
  33.  
  34.  bptr := Ptr(Seg(pic^),Ofs(pic^));
  35.  
  36.  Writeln;
  37.  FOR linectr := 1 TO 16 DO
  38.   Write('0123456789ABCDEF');
  39.  
  40.  Writeln;
  41.  Writeln;
  42.  
  43.  linectr := -1;
  44.  
  45.  REPEAT
  46.  
  47.   picbyte := bptr^;             { pick up the byte      }
  48.  
  49.   CASE picbyte OF
  50.    fieldsync : BEGIN
  51.            Writeln('Field sync');
  52.            linectr := -1;
  53.                END;
  54.    linesync  : BEGIN
  55.            linectr := linectr + 1;
  56.            Writeln;
  57.            Write(linectr:4,':  ');
  58.                END;
  59.    fldend    : BEGIN
  60.            Writeln;
  61.            Writeln('End of picture');
  62.                END;
  63.    fullres   : BEGIN
  64.            Writeln;
  65.            Writeln('Full resolution');
  66.                END;
  67.    halfres   : BEGIN
  68.            Writeln;
  69.            Writeln('Half resolution');
  70.                END;
  71.    quartres  : BEGIN
  72.            Writeln;
  73.            Writeln('Quarter resolution');
  74.                END;
  75.    ELSE CASE (picbyte AND $F0) OF
  76.     rep1   : BEGIN
  77.            Write('x',(picbyte AND $0F),' ');
  78.              END;
  79.     rep16  : BEGIN
  80.            Write('x',16*(picbyte AND $0F),' ');
  81.              END;
  82.     ELSE BEGIN
  83.            Write(ByteToHex(picbyte),' ');
  84.         END;
  85.     END;
  86.   END;
  87.  
  88.   bptr := Ptr(Seg(bptr^),Ofs(bptr^)+1);
  89.  
  90.  UNTIL picbyte = fldend;
  91.  
  92. END;
  93.  
  94.  
  95. {-------------------------------------------------------}
  96. { Return a more or less unique character for each pel   }
  97. { Note that the characters are defined globally         }
  98.  
  99. CONST
  100.  csetlen   = 64;
  101.  
  102.  charset   : STRING[csetlen] =
  103. '.abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789*';
  104.  
  105. FUNCTION Chars(ID : BYTE) : CHAR;
  106.  
  107. BEGIN
  108.  
  109.  IF (ID < csetlen) AND (ID >= 0)
  110.   THEN Chars := charset[ID+1]
  111.   ELSE Chars := '?';
  112.  
  113. END;
  114.  
  115. {-------------------------------------------------------}
  116. { Dump formatted picture                                }
  117.  
  118. PROCEDURE FmtDump(pic : picptr);
  119.  
  120. VAR
  121.  picbyte   : BYTE;
  122.  oldbyte   : BYTE;
  123.  bptr      : ^BYTE;
  124.  repcount  : INTEGER;
  125.  reps      : INTEGER;
  126.  done      : BOOLEAN;
  127.  linectr   : INTEGER;
  128.  
  129. BEGIN
  130.  
  131.  bptr := Ptr(Seg(pic^),Ofs(pic^));
  132.  oldbyte := 0;
  133.  done := FALSE;
  134.  
  135.  REPEAT
  136.  
  137.   picbyte := bptr^;             { pick up the byte      }
  138.  
  139.   CASE picbyte OF
  140.    fieldsync : BEGIN
  141.            Writeln;
  142.            Writeln('Field sync');
  143.            linectr := -1;
  144.                END;
  145.    linesync  : BEGIN
  146.            linectr := linectr + 1;
  147.            Writeln;             { eject to next line    }
  148.            Write(linectr:4,':  ');
  149.            oldbyte := 0;        { reset memory          }
  150.                END;
  151.    fldend    : BEGIN
  152.            Writeln;
  153.            Writeln('End of picture');
  154.            done := TRUE;
  155.                END;
  156.    fullres   : BEGIN
  157.            Writeln;
  158.            Writeln('Full resolution');
  159.                END;
  160.    halfres   : BEGIN
  161.            Writeln;
  162.            Writeln('Half resolution');
  163.                END;
  164.    quartres  : BEGIN
  165.            Writeln;
  166.            Writeln('Quarter resolution');
  167.                END;
  168.    ELSE CASE (picbyte AND $F0) OF
  169.     rep1   : BEGIN
  170.            repcount := picbyte AND $0F;
  171.            IF repcount = 0
  172.             THEN repcount := 16;
  173.            FOR reps := 1 TO repcount DO
  174.             Write(Chars(oldbyte));
  175.              END;
  176.     rep16  : BEGIN
  177.            repcount := 16 * (picbyte AND $0F);
  178.            IF repcount = 0
  179.             THEN repcount := 256;
  180.            FOR reps := 1 TO repcount DO
  181.             Write(Chars(oldbyte));
  182.              END;
  183.     ELSE BEGIN
  184.             Write(Chars(picbyte));
  185.             oldbyte := picbyte;
  186.         END;
  187.     END;
  188.   END;
  189.  
  190.   bptr := Ptr(Seg(bptr^),Ofs(bptr^)+1);
  191.  
  192.  UNTIL done;
  193.  
  194. END;
  195.  
  196.  
  197. {-------------------------------------------------------}
  198. { Main routine                                          }
  199.  
  200. BEGIN
  201.  
  202.  pic0 := NIL;                   { ensure new alloc      }
  203.  PicSetup(pic0);                { set up picture array  }
  204.  LoadPicture(ParamStr(1),pic0); { load picture          }
  205.  FmtDump(pic0);                 { do formatted dump     }
  206.  Write(Chr(ff));                { eject the page        }
  207.  HexDump(pic0);                 { do hex dump           }
  208.  
  209. END.
  210.